home *** CD-ROM | disk | FTP | other *** search
/ Mac Magazin/MacEasy 34 / Mac Magazin and MacEasy Magazine CD - Issue 34.iso / Grafik & Text / Alpha ƒ / Tcl / Menus / filesetsMenu.tcl < prev    next >
Text File  |  1997-05-02  |  44KB  |  1,577 lines
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #    Vince's    Additions -    an extension package for Alpha
  4.  # 
  5.  #    FILE: "filesets.tcl"
  6.  #                                      created: 20/7/96 {6:22:25 pm} 
  7.  #                                  last update: 6/4/97 {11:16:07 am} 
  8.  #    Author:    Vince Darley
  9.  #    E-mail:    <darley@fas.harvard.edu>
  10.  #      mail:    Division of    Applied    Sciences, Harvard University
  11.  #            Oxford Street, Cambridge MA    02138, USA
  12.  #       www:    <http://www.fas.harvard.edu/~darley/>
  13.  #    
  14.  #==============================================================================
  15.  # Alpha calls two fileset-related routines, 'getCurrFileSet', and 
  16.  # 'getFileSetNames'. Alpha will also attempt to set the variable 'currFileSet'
  17.  # on occasion, but this isn't critical.
  18.  #==============================================================================
  19.  # 
  20.  #  modified by  rev reason
  21.  #  -------- --- --- -----------
  22.  #  24/3/96  VMD 1.0 update of Pete's original to allow mode-specific filesets
  23.  #  27/3/96  VMD 1.1 added hierarchial filesets, and checks for unique menus
  24.  #  13/6/96  VMD 1.2 memory efficiency improvements with 'fileSets' array
  25.  #  10/3/97  VMD 1.3 added 'procedural' fsets, including 'Open Windows'
  26.  #  6/4/97   VMD 1.31 various fixes incorporated - thanks!
  27.  # ###################################################################
  28.  ##
  29.  
  30. ## 
  31.  # These procedures    are    now    more robust    and    general-purpose. Basic new
  32.  # features    are: 
  33.  # 
  34.  #       *  user configurable    menu
  35.  #       *  unique-menu names    are    ensured, so    there can be no    clashes
  36.  #       *  new fileset types    ('tex' and 'fromHierarchy')
  37.  #       *  new utility functions    ('stuff', 'wordCount',...)
  38.  #       *  filesets need    not    appear in the menu;    in fact    they can be
  39.  #          anywhere you like
  40.  ##
  41.  
  42. if $startingUp {
  43.     addMenu fsetMenuName
  44.     set fsetMenuName     "•131"
  45.     return
  46. }
  47.  
  48. ## 
  49.  # -------------------------------------------------------------------------
  50.  #     
  51.  # "gCheckset" --
  52.  #    
  53.  #    If the global variable 'var' isn't yet defined,    it is set to the
  54.  #    value 'val'.  Else nothing happens.
  55.  #           
  56.  # -------------------------------------------------------------------------
  57.  ##
  58. proc gCheckset {v val} {
  59.     upvar \#0 $v var
  60.     if [info exists var] { return [set var] }
  61.     return [set var $val]
  62. }
  63.  
  64. proc fsetMenuName {} {}
  65. # Build some filesets on the fly.
  66. catch {unset fileSets}
  67. catch {unset currFileSet}
  68. set gfileSets(Help) "$HOME:Help:*"
  69. set gfileSets(System) "$HOME:Tcl:SystemCode:*.tcl"
  70. set gfileSets(Menus) "$HOME:Tcl:Menus:*.tcl"
  71. set gfileSets(Modes) "$HOME:Tcl:Modes:*.tcl"
  72. set "gfileSets(Open Windows)" procFilesetOpenWindows 
  73. set gfileSetsType(Help) "fromDirectory"
  74. set gfileSetsType(System) "fromDirectory"
  75. set gfileSetsType(Menus) "fromDirectory"
  76. set gfileSetsType(Modes) "fromDirectory"
  77. set "gfileSetsType(Open Windows)" "procedural"
  78.  
  79. proc procFilesetOpenWindows {} { return [winNames -f] }
  80.  
  81. if !$alphaLite { 
  82.     set gfileSets(User) "$HOME:Tcl:UserCode:*.tcl"
  83.     set gfileSetsType(User) "fromDirectory"
  84. }
  85.  
  86. # Default curr fileset is the first one. Can be changed in 'prefs.tcl'.
  87. set currFileSet [lindex [array names gfileSets] 0]
  88.  
  89. #################################################
  90. #                                                #
  91. #    Section    1:    Fileset    variables and flags.    #
  92. #                                                #
  93. #################################################
  94. # Any of these can be over-ridden by the stored #
  95. # definitions in defs.tcl, arrdefs.tcl          #
  96. #################################################
  97.  
  98. ## 
  99.  # We don't    show the 'help'    fileset, since it's    under the MacOS
  100.  # AppleGuide menu.     Also we could perhaps yank    tex-filesets away
  101.  # into    their own menu,    in which case the tex-system could add to
  102.  # this    variable as    it went    along.
  103.  ##
  104. gCheckset filesetsNotInMenu { "Help" "Open Windows" }
  105.  
  106. ## 
  107.  # A type is a means of    generating a fileset given its 
  108.  # description in the variable 'gfileSets(name)':
  109.  ##
  110. gCheckset fileSetsTypes { "list" "glob" "fromHierarchy" "procedural" }
  111.  
  112. ## 
  113.  # A menu type is a    means of prompting the user    and    
  114.  # characterising the interface    to a type, even
  115.  # though the actual storage may be    very simple
  116.  # (a list in most cases).
  117.  ##
  118. set fileSetsTypesThing(fromDirectory) "glob"
  119. set fileSetsTypesThing(fromHierarchy) "fromHierarchy"
  120. set fileSetsTypesThing(think) "list"
  121. set fileSetsTypesThing(codewarrior) "list"
  122. set fileSetsTypesThing(ftp) "list"
  123. set fileSetsTypesThing(fromOpenWindows) "list"
  124. set fileSetsTypesThing(procedural) "procedural"
  125.  
  126. ## 
  127.  # To add a    new    fileset    type, you need to define the following:
  128.  #       set fileSetsTypesThing(myType) "list"
  129.  #       proc    myTypeCreateFileset    {} {}
  130.  #       proc    myTypeFilesetUpdate    {name} {}
  131.  # 
  132.  # For more    complex    types (e.g.    the    tex-type), define as follows:
  133.  #       set fileSetsTypesThing(myType) "myType"
  134.  #       proc    myTypeCreateFileset    {} {}
  135.  #       proc    myTypeFilesetSelected {    fset menu item }    {}
  136.  #       proc    myTypeFilesetUpdate    { name } {}
  137.  #       proc    myTypeListFilesInFileset { name    } {}
  138.  #       proc    myTypeMakeFileSetSubMenu { name    } {}
  139.  # 
  140.  # These procedures    will all be    called automatically under the
  141.  # correct circumstances.  The purposes of these are as follows:
  142.  #
  143.  #   'create'   -- query the user for name etc. and create
  144.  #   'update'   -- given the information in 'gfileSets', recalculate
  145.  #                   the member files.
  146.  #   'selected' -- a member was selected in a menu.
  147.  #   'list'     -- given info in all except 'fileSets', return list
  148.  #                 of files to be stored in that variable.
  149.  #   'submenu'  -- generate the sub-menu
  150.  # 
  151.  # Your    code may wish to call 'isWindowInFileset ?win? ?type?' to
  152.  # check if    a given    (current by    default) window    is in a    fileset    of
  153.  # a given type.
  154.  ##
  155.  
  156. ## 
  157.  # -------------------------------------------------------------------------
  158.  #     
  159.  #    "filesetSortOrder" --
  160.  #    
  161.  #       The structure of    this variable dictates how the fileset
  162.  #       menu    is structured:
  163.  #           
  164.  #           '{pattern p}' 
  165.  #               lists all filesets which    match 'p'
  166.  #           '-' 
  167.  #               adds    a separator    line
  168.  #           '{list of types}' 
  169.  #               lists all filesets of those types.
  170.  #           '{submenu name sub-order-list}' 
  171.  #               adds    a submenu with name    'name' and recursively
  172.  #               adds    filesets to    that submenu as    given by the 
  173.  #               sub-order.
  174.  #               
  175.  #       Leading,    trailing and double    separators are automatically
  176.  #       removed.
  177.  #     
  178.  # -------------------------------------------------------------------------
  179.  ##
  180. gCheckset filesetSortOrder { {pattern System} {pattern Menus} {pattern Modes} {pattern User} {pattern Preferences} \
  181.     - {tex} - {pattern *.cc} {submenu Headers {pattern *.h}} \
  182.     - {fromDirectory think codewarrior ftp \
  183.     fromOpenWindows fromHierarchy} * } 
  184.                         
  185. set    "filesetUtils(browseFileset…)" [list * browseFileset]
  186. set    "filesetUtils(renameFileset…)" [list * renameFileset]
  187. set    "filesetUtils(openEntireFileset…)" [list * openEntireFileset]
  188. set    "filesetUtils(filesetToAlpha…)" [list * filesetToAlpha]
  189. set    "filesetUtils(closeEntireFileset…)" [list * closeEntireFileset]
  190. set    "filesetUtils(replaceInFileset…)" [list * replaceInFileset]
  191. set    "filesetUtils(stuffFileset…)" [list * stuffFileset]
  192. set    "filesetUtils(wordCount)" [list * wordCountFileset]
  193. set    "filesetUtils(wordCountFast)" [list * wordCountFilesetFast]
  194. set    "filesetUtils(openFilesetFolder…)" [list * openFilesetFolder]
  195.  
  196.  
  197. ## 
  198.  # The meaning of these    flags is as    follows:
  199.  #       sortFilesetItems    -- 
  200.  #           a type can have the option of being unsorted    (e.g. tex-filesets)
  201.  #       indentFilesetItems --
  202.  #           visual formatting may be    of relevance to    some types
  203.  #       sortFilesetsByType -- 
  204.  #           use the variable    'filesetSortOrder' to determine    the
  205.  #           visual structure    of the fileset menu
  206.  #       autoAdjustFileset --
  207.  #           when    a file is selected from    the    menu, do we    try    and    
  208.  #           keep    'currFileSet' accurate?
  209.  #       includeNonTextFiles --
  210.  #           filesets may include non-text files.  Alpha will tell the
  211.  #           finder to open these if they are selected.
  212.  ##        
  213. foreach    flag { sortFilesetItems    indentFilesetItems sortFilesetsByType \
  214.                autoAdjustFileset includeNonTextFiles } {
  215.     gCheckset filesetFlags($flag) 0
  216. }
  217. unset flag
  218. set filesetFlagsRebuild(sortFilesetsByType) "*"
  219. set filesetFlagsRebuild(includeNonTextFiles) "*"
  220.  
  221. # To add a new fileset type, all we have to do is this:
  222. set fileSetsTypesThing(tex) "tex"
  223. lappend fileSetsTypes "tex"
  224. # If you create new types just add lines like that to
  225. # your "prefs.tcl", or install them permanently using
  226. # addDef and addArrDef.
  227.  
  228. #===========================================================================
  229. # The support routines.
  230. #===========================================================================
  231. # Called from Alpha to get list of files for current file set.
  232. proc getCurrFileSet {} {
  233.     global currFileSet
  234.     return [getFileSet $currFileSet]
  235. }
  236.  
  237. # Called from Alpha to get names. The first name returned is taken to 
  238. # be the current fileset.
  239. proc getFileSetNames {} {
  240.     global gfileSets currFileSet gDirScan
  241.     set perm [list $currFileSet]
  242.     set temp {}
  243.     set ind [lsearch [array names gfileSets] $currFileSet]
  244.     if {$ind < 0} {set ind 0}
  245.     foreach n [lsort -ignore [array names gfileSets]] {
  246.         if {[info exists gDirScan($n)]} {
  247.             lappend temp $n
  248.         } else {
  249.             lappend perm $n
  250.         }
  251.     }
  252.     if {$temp != {}} {
  253.         return [concat $perm - $temp]
  254.     } else {
  255.         return $perm
  256.     }
  257. }
  258.  
  259.  
  260. # Keep 'sets' menu up to date.
  261. trace vdelete currFileSet w shadowCurrFileSet
  262. trace variable currFileSet w shadowCurrFileSet
  263. proc shadowCurrFileSet {nm1 nm2 op} {
  264.     global gfileSets currFileSet
  265.     foreach name [array names gfileSets] {
  266.         if {$name == $currFileSet} {
  267.             catch {markMenuItem -m choose $name on}
  268.         } else {
  269.             catch {markMenuItem -m choose $name off}
  270.         }
  271.     }
  272.     return $currFileSet
  273. }
  274.  
  275.  
  276. #================================================================================
  277. # Edit a file from a fileset via list dialogs (no mousing around).
  278. #================================================================================
  279. proc editFile {} {
  280.     global currFileSet modifiedVars gfileSetsType
  281.     
  282.     set fset [pickFileset "" {Fileset?} "list" [list {*recent*}]]
  283.     set currFileSet $fset
  284.     lappend modifiedVars currFileSet
  285.     
  286.     if {$fset == {*recent*}} {return [editRecentFile]}
  287.     set ff [getFilesInSet $fset]
  288.     foreach f $ff {
  289.         lappend disp [file tail $f]
  290.     }
  291.     foreach res [listpick -l -p {File?} [lsort -ignore $disp]]  {
  292.         set ind [lsearch $ff \*:$res]
  293.         if {$gfileSetsType($fset) == "ftp"} {
  294.             ftpFilesetOpen $fset [lindex $ff $ind]
  295.         } else {
  296.             catch {generalOpenFile [lindex $ff $ind]}
  297.         }
  298.     }
  299. }
  300.  
  301. # We only return TEXT files, since we don't want Alpha
  302. # manipulating the data fork of non-text files.
  303. proc getFileSet {fset} {
  304.     global filesetFlags
  305.     if $filesetFlags(includeNonTextFiles) {
  306.         set fnames ""
  307.         foreach f [getFilesInSet $fset] {
  308.             if [file isfile $f] {
  309.                 getFileInfo $f a
  310.                 if {$a(type) == "TEXT"} {
  311.                     lappend fnames $f
  312.                 }
  313.             }
  314.         }
  315.         return $fnames
  316.     } else {
  317.         return [getFilesInSet $fset]
  318.     }
  319. }
  320.  
  321. proc browseFileset {{fset ""}} {
  322.     global tileLeft tileTop tileWidth errorHeight
  323.  
  324.     set fset [pickFileset $fset {Fileset?}]
  325.  
  326.     foreach f [getFilesInSet $fset] {
  327.         append text "\t[file tail $f]\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$f\r"
  328.     }
  329.     new -n "* FileSet '$fset' Browser *" -g $tileLeft $tileTop 200 $errorHeight
  330.     global winModes
  331.     set name [lindex [winNames] 0]
  332.     changeMode [set winModes($name) Brws]
  333.  
  334.     insertText "(<cr> to go to file)\r-----\r$text\r"
  335.     goto 0
  336.     select [nextLineStart [nextLineStart 0]] [nextLineStart [nextLineStart [nextLineStart 0]]]
  337.     setWinInfo dirty 0
  338.     setWinInfo read-only 1
  339.     message ""
  340. }    
  341.  
  342. ############################################
  343. #                                           #
  344. #    Section    2:    Basic fileset procedures   #
  345. #                                           #
  346. ############################################
  347.  
  348. proc newFileset {} {
  349.     global currFileSet gfileSetsType fileSetsTypesThing
  350.     set type [eval [list prompt "New fileset type?" \
  351.                 "fromDirectory" "Type:"] [lsort -ignore [array names fileSetsTypesThing]]]
  352.     set name [eval ${type}CreateFileset]
  353.  
  354.     if ![string length $name] return
  355.     
  356.     addArrDef gfileSetsType $name $type
  357.     set gfileSetsType($name) $type
  358.  
  359.     set currFileSet $name
  360.     filesetsJustChanged $type $name
  361.     return $currFileSet
  362. }
  363.  
  364. ## 
  365.  # -------------------------------------------------------------------------
  366.  # 
  367.  # "filesetsJustChanged" --
  368.  # 
  369.  #  If we've added, deleted, modified a fileset, we call this procedure.
  370.  #  In most cases we must rebuild everything (due to limitations in Alpha),
  371.  #  but for 'procedural' filesets, we can just do the utilities menu.
  372.  # -------------------------------------------------------------------------
  373.  ##
  374. proc filesetsJustChanged {type name} {
  375.     if {$type == "procedural"} {
  376.         global filesetsNotInMenu modifiedVars
  377.         if {[lsearch $filesetsNotInMenu $name] == -1} {
  378.             lappend filesetsNotInMenu $name
  379.             lappend modifiedVars filesetsNotInMenu
  380.         }
  381.         rebuildFilesetUtilsMenu
  382.     } else {
  383.         rebuildAllFilesets
  384.     }
  385. }
  386.  
  387. proc deleteFileset { {fset ""} {yes 0} } {
  388.     global fileSets gfileSets currFileSet fileSetsExtra gfileSetsType
  389.     global fsetMenuName subMenuFilesetInfo subMenuInfo filesetsNotInMenu
  390.     global modifiedVars
  391.     
  392.     set fset [pickFileset $fset "Delete which Fileset?"]
  393.      if {$currFileSet == $fset} {catch {set currFileSet System}}
  394.  
  395.     if {$yes || [askyesno "Delete fileset \"$fset\"?"] == "yes"} {
  396.         catch {unset "fileSetsExtra($fset)"}
  397.         catch {unset "gfileSetsType($fset)"}
  398.         catch {unset "fileSets($fset)"}
  399.         catch {unset "gfileSets($fset)"}
  400.         
  401.         removeArrDef gfileSetsType $fset
  402.         catch {removeArrDef fileSetsExtra $fset}
  403.         removeArrDef gfileSets $fset
  404.  
  405.         # find its menu:
  406.         set base ""
  407.         if [info exists subMenuFilesetInfo($fset)] {
  408.             foreach m $subMenuFilesetInfo($fset) {
  409.                 # remove info about it's name
  410.                 catch {unset subMenuInfo($m)}
  411.                 catch {removeMenu $m}
  412.                 # try and remove it's base from the main menu too
  413.                 if { [string trimright $m] == $fset } { set base $m }
  414.             }
  415.             unset subMenuFilesetInfo($fset)
  416.         }
  417.         
  418.         if {[set l [lsearch  $filesetsNotInMenu $fset]] != -1} {
  419.             set filesetsNotInMenu [lreplace $filesetsNotInMenu $l $l]
  420.             lappend modifiedVars filesetsNotInMenu
  421.             deleteMenuItem -m choose $fset
  422.             deleteMenuItem -m hideFileset $fset
  423.             return
  424.         }
  425.         if [catch {deleteMenuItem -m $fsetMenuName $base}] {
  426.             # it's on a submenu or somewhere else so we just have
  427.             # to do the lot!
  428.             if !$yes { rebuildAllFilesets }
  429.         } else {
  430.             deleteMenuItem -m choose $fset
  431.             deleteMenuItem -m hideFileset $fset
  432.         }
  433.     }
  434. }
  435.  
  436. ## 
  437.  # -------------------------------------------------------------------------
  438.  #     
  439.  #    "pickFileset" --
  440.  #    
  441.  #     Ask the user for a/several    filesets.  If 'fset' is    set, we    just
  442.  #     return    that (this avoids 'if {$fset !=    ""}    { set fset [pick...] }
  443.  #     constructs    everywhere).  A    prompt can be given, and a dialog type
  444.  #     (either a listpick, a pop-up menu,    or a listpick with multiple
  445.  #     selection), and extra items can be    added to the list if desired.
  446.  # -------------------------------------------------------------------------
  447.  ##
  448. proc pickFileset { fset {prompt Fileset?} {type "list"} {extras {}} } {
  449.     global gfileSets currFileSet
  450.     if { $fset != "" } { return $fset }
  451.     switch $type {
  452.         "popup" {
  453.             set fset [eval [list prompt $prompt \
  454.                 $currFileSet "FileSet:"] [lsort -ignore [array names gfileSets]]]
  455.             if ![info exists gfileSets($fset)] { error "No such fileset" }
  456.             return $fset
  457.         }
  458.         "list" {
  459.             return [listpick -p $prompt -L $currFileSet \
  460.                 [lsort -ignore [concat $extras [array names gfileSets]]]]
  461.         }
  462.         "multilist" {
  463.             return [listpick -p $prompt -l -L $currFileSet \
  464.                 [lsort -ignore [concat $extras [array names gfileSets]]]]
  465.         }        
  466.     }
  467. }
  468.  
  469. proc renameFileset {} {
  470.     global fileSets gfileSets currFileSet fileSetsExtra gfileSetsType
  471.     global fileSetsTypesThing
  472.     
  473.     set fset [pickFileset "" {Fileset to rename?}]
  474.      
  475.     set name [getline "Rename to:" $fset]
  476.     if {![string length $name] || $name == $fset} return
  477.  
  478.     set gfileSets($name) $gfileSets($fset)
  479.     set gfileSetsType($name) $gfileSetsType($fset)
  480.     catch {set fileSets($name) $fileSets($fset)}
  481.     catch {set fileSetsExtra($name) $fileSetsExtra($fset)}
  482.  
  483.     deleteFileset $fset 1
  484.     
  485.     addArrDef gfileSets $name $gfileSets($name)
  486.     addArrDef gfileSetsType $name $gfileSetsType($name)
  487.     catch {addArrDef fileSetsExtra $name $fileSetsExtra($name)}
  488.     
  489.     filesetsJustChanged $gfileSetsType($name) $name
  490.     set currFileSet $name
  491. }
  492.  
  493. proc updateCurrentFileset {} {
  494.     global currFileSet gfileSetsType
  495.     set type $gfileSetsType($currFileSet)
  496.     catch {eval "${type}FilesetUpdate" \{$currFileSet\} }
  497.     eval [makeFileSetAndMenu $currFileSet 1]
  498.     
  499.     callFilesetUpdateProcedures $currFileSet
  500. }
  501.  
  502. proc callFilesetUpdateProcedures { {fset ""} } {
  503.     global filesetUpdateProcs gfileSetsType
  504.     if { $fset == "" } {
  505.         set types [array names filesetUpdateProcs]
  506.     } else {
  507.         set types $gfileSetsType($fset)
  508.     }
  509.     
  510.     foreach l $types {
  511.         if [info exists filesetUpdateProcs($l)] {
  512.             foreach proc $filesetUpdateProcs($l) {
  513.                 eval $proc
  514.             }
  515.         }
  516.     }
  517.     
  518. }
  519.  
  520. proc listContains { list item } { return [expr [lsearch -exact $list $item] != -1] }
  521.  
  522.  
  523. ##################################################
  524. #                                                 #
  525. #    Section    3: Creation    of basic fileset types     #
  526. #                                                 #
  527. ##################################################
  528.  
  529. proc proceduralCreateFileset {} {
  530.     global gfileSets gfileSetsType filesetsNotInMenu modifiedVars
  531.     set name [getline "Name for this fileset…"]
  532.     if {![string length $name]} return
  533.     set gfileSetsType($name) "procedural"
  534.     set p procFileset[join $name ""]
  535.     set gfileSets($name) $p
  536.     addUserLine "\# procedure to list files in fileset '$name' on the fly"
  537.     addUserLine "proc $p \{\} \{"
  538.     addUserLine "\t"
  539.     addUserLine "\}"
  540.     addArrDef gfileSets $name $gfileSets($name)
  541.     addArrDef gfileSetsType $name "procedural"
  542.     if {[askyesno "I've added a template for the procedure to your 'prefs.tcl'. Do you want to edit it now?"] == "yes"} {
  543.         editPrefs
  544.         goto [maxPos]
  545.         beep
  546.         message "Make sure you 'load' the new procedure."
  547.     }
  548.     lappend filesetsNotInMenu $name
  549.     return $name
  550. }
  551.  
  552. proc fromDirectoryCreateFileset {} {
  553.     global gfileSets gfileSetsType    
  554.     
  555.     set name [getFilesetDirectoryAndPattern]
  556.     if ![string length $name] return
  557.     
  558.     set gfileSetsType($name) "fromDirectory"
  559.     
  560.     if {[askyesno "Save new fileset?"] == "yes"} {
  561.         addArrDef gfileSets $name $gfileSets($name)
  562.         addArrDef gfileSetsType $name "fromDirectory"
  563.     }
  564.     return $name
  565. }
  566.  
  567. proc getFilesetDirectoryAndPattern {} {
  568.     global gfileSets
  569.     set name [getline "New fileset name:" ""]
  570.     if {![string length $name]} return
  571.     
  572.     set dir [string trim [get_directory -p "New fileset dir:"] ":"]
  573.     if {![string length $dir]} return
  574.     
  575.     set filePat [getline "File pattern:" "*"]
  576.     if {![string length $filePat]} return
  577.     
  578.     set gfileSets($name) "$dir:$filePat"
  579.     return $name
  580. }
  581.  
  582. proc fromDirectoryFilesetUpdate {name} {
  583.     # done on the fly so no need to update
  584.     #global fileSets gfileSets
  585.     #set fileSets($name) [glob -nocomplain -t TEXT "$gfileSets($name)"]
  586. }
  587.  
  588. proc fromHierarchyCreateFileset {} {
  589.     global gfileSets gfileSetsType    
  590.     
  591.     set name [getFilesetDirectoryAndPattern]
  592.     if ![string length $name] return
  593.     
  594.     set gfileSetsType($name) "fromHierarchy"
  595.     set depth [listpick -p "Depth of hierarchy?" -L 3 {1 2 3 4 5 6 7}]
  596.     if { $depth == "" } {set depth 3}
  597.     
  598.     set gfileSets($name) [list $gfileSets($name) $depth]
  599.     
  600.     if {[askyesno "Save new fileset?"] == "yes"} {
  601.         addArrDef gfileSets $name $gfileSets($name)
  602.         addArrDef gfileSetsType $name "fromHierarchy"
  603.     }
  604.     return $name
  605. }
  606.  
  607. proc fromHierarchyFilesetUpdate {name} {
  608.     global fileSets gfileSets
  609.     set fileSets($name) [fromHierarchyListFilesInFileSet $name]
  610. }
  611.  
  612. proc fromHierarchyMakeFileSetAndMenu {name andMenu} {
  613.     global filesetTemp fileSets gfileSets
  614.     set dir [file dirname [lindex $gfileSets($name) 0]]
  615.     set patt [file tail [lindex $gfileSets($name) 0]]
  616.     set depth [lindex $gfileSets($name) 1]
  617.     # we make the menu as a string, but can bin it if we like
  618.     set menu [buildSubMenu [list $dir] $name filesetProc filesetTemp $patt $depth $name]
  619.     
  620.     # we need to construct the list of items
  621.     set fileSets($name) {}
  622.     foreach n [array names filesetTemp] {
  623.         lappend fileSets($name) $filesetTemp($n)
  624.     }
  625.     unset filesetTemp
  626.     return $menu
  627. }
  628.  
  629. proc fromHierarchyFilesetSelected {fset menu item} {
  630.     global gfileSets
  631.     set dir [file dirname [lindex $gfileSets($fset) 0]]
  632.     set ff [getFilesInSet $fset]
  633.     if { $fset == $menu } {
  634.         # it's top level
  635.         if {[set match [lsearch $ff ${dir}:$item]] >= 0} {
  636.             autoUpdateFileset $fset
  637.             generalOpenFile [lindex $ff $match]
  638.             return
  639.         }
  640.     }
  641.     # the following two are slightly cumbersome, but give us the best
  642.     # chance of finding the correct file given any ambiguity (which can
  643.     # certainly arise if file and directory names clash excessively).
  644.     if {[set match [lsearch $ff ${dir}:${menu}:$item]] >= 0} {
  645.         autoUpdateFileset $fset
  646.         generalOpenFile [lindex $ff $match]
  647.         return
  648.     }
  649.     if {[set match [lsearch $ff ${dir}:*:${menu}:$item]] >= 0} {
  650.         autoUpdateFileset $fset
  651.         generalOpenFile [lindex $ff $match]
  652.         return
  653.     }
  654.     alertnote "Weird! Couldn't find it."
  655. }
  656.  
  657.  
  658. proc codewarriorCreateTagFile {} { return [alphaCreateTagFile] }
  659. proc thinkCreateTagFile {} { return [alphaCreateTagFile] }
  660. proc codewarriorCreateFileset {} { return [createWarriorFileset] }
  661. proc thinkCreateFileset {} { return [createThinkFileset] }
  662.  
  663. proc fromOpenWindowsCreateFileset {} {
  664.     global gfileSets
  665.     
  666.     set name [prompt "Create fileset containing current windows under what name?" "OpenWins"]
  667.  
  668.     addArrDef gfileSets $name [winNames -f]
  669.     set gfileSets($name) [winNames -f]
  670.  
  671.     return $name
  672. }
  673.  
  674. ##################################
  675. #                                 #
  676. #    Section    4: Menu    Procedures     #
  677. #                                 #
  678. ##################################
  679.  
  680. ## 
  681.  # Global procedures to    deal with the fact that    Alpha can only have    one
  682.  # menu    with each given    name.  This    is only    a problem in dealing with
  683.  # user-defined    menus such as fileset menus, tex-package menus,    ...
  684.  ##
  685.  
  686. ## 
  687.  # -------------------------------------------------------------------------
  688.  #     
  689.  #    "makeFilesetSubMenu" --
  690.  #    
  691.  #     If    desired    this is    the    only procedure you need    use    ---    it returns
  692.  #     a menu    creation string, taking    account    of the unique name requirement
  693.  #     and will make sure    your procedure 'proc' is called    with the real
  694.  #     menu name!
  695.  # -------------------------------------------------------------------------
  696.  ##
  697. proc makeFilesetSubMenu {fset name proc args} {
  698.     if { [string length $proc] > 1 } {
  699.         return [concat {menu -n} [list [registerFilesetMenuName $fset $name $proc]] -p subMenuProc $args]
  700.     } else {
  701.         return [concat {menu -n} [list [registerFilesetMenuName $fset $name]] $args]
  702.     }
  703. }
  704.  
  705. ## 
  706.  # -------------------------------------------------------------------------
  707.  #     
  708.  #    "registerFilesetMenuName" --
  709.  #    
  710.  #     Call to ensure    unique fileset submenu names.  We just add spaces
  711.  #     as    appropriate    and    keep track of everything for you!  Filesets
  712.  #     which have    multiple menus _must_ register the main    menu first.
  713.  # -------------------------------------------------------------------------
  714.  ##
  715. proc registerFilesetMenuName {fset name {proc ""}} {
  716.     global subMenuInfo subMenuFilesetInfo
  717.     if { $fset == $name && [info exists subMenuFilesetInfo($fset)] } {
  718.         # if the fileset already has a base menu, use that:
  719.         foreach n $subMenuFilesetInfo($fset) {
  720.             if { [string trimright $n] == $fset } {
  721.                 set base $n
  722.             } 
  723.             unset subMenuInfo($n)
  724.         }
  725.         unset subMenuFilesetInfo($fset)
  726.     }
  727.     set original $name                    
  728.     if [info exists base] {
  729.         set name $base
  730.     } else {
  731.         # I add at least one space to _all_ hierarchical submenus now.
  732.         # This is so I won't clash with any current or future modes
  733.         # which should never normally add spaces themselves.
  734.         append name " "
  735.         while { [info exists subMenuInfo($name)] } {
  736.             append name " "
  737.         }        
  738.     }
  739.     
  740.     set subMenuInfo($name) [list "$fset" "$original" "$proc"]
  741.     # build list of a fileset's menus
  742.     lappend subMenuFilesetInfo($fset) "$name"
  743.     
  744.     return $name
  745. }
  746.  
  747.  
  748. proc realMenuName {name} {
  749.     global subMenuInfo
  750.     return [lindex $subMenuInfo($name) 1]
  751. }
  752.  
  753. ## 
  754.  # -------------------------------------------------------------------------
  755.  #     
  756.  #    "subMenuProc" --
  757.  #    
  758.  #     This procedure    is implicitly used to deal with    ensuring unique
  759.  #     sub-menu names.  It calls the procedure you asked for,    with
  760.  #     the name of the menu you think    you're using.
  761.  # -------------------------------------------------------------------------
  762.  ##
  763. proc subMenuProc {menu item} {
  764.     global subMenuInfo
  765.     set l $subMenuInfo($menu)
  766.     set realProc [lindex $l 2]
  767.     # try and call the proc with three arguments (fileset is 1st)
  768.     if [catch {$realProc [lindex $l 0] [lindex $l 1] "$item"}] {
  769.         $realProc [lindex $l 1] "$item"
  770.     }
  771. }
  772.  
  773.  
  774. proc filesetMenuProc {menu item} {
  775.     global HOME
  776.     switch $item {
  777.         "Edit File" {
  778.         editFile
  779.         return
  780.         } 
  781.     "Help" {
  782.         editMark "$HOME:Help:Manual" "File Sets" -r
  783.         return
  784.         }
  785.     "New Fileset" {
  786.         return [newFileset]
  787.         }
  788.     "Delete Fileset" {
  789.         return [deleteFileset]
  790.         }
  791.     }
  792.  
  793. }
  794.  
  795. ## 
  796.  # -------------------------------------------------------------------------
  797.  #     
  798.  #    "filesetProc" --
  799.  #    
  800.  #     Must be called    by 'subMenuProc'
  801.  # -------------------------------------------------------------------------
  802.  ##
  803. proc filesetProc {fset menu item} {
  804.     global gfileSetsType 
  805.     if {$fset != ""} {set m $fset} else { set m $menu}
  806.     switch $gfileSetsType($m) {
  807.         "fromDirectory" -
  808.         "think" -
  809.         "codewarrior" -
  810.         "fromOpenWindows" {
  811.             filesetBasicOpen $m $item
  812.         }
  813.         "ftp" { ftpFilesetOpen $m $item }
  814.         "default" {
  815.             # try a type-specific method first
  816.             if [catch {eval $gfileSetsType($m)FilesetSelected \{$fset\} \{$menu\} \{$item\}}] {
  817.                 # if that failed then perhaps it only wants two parameters
  818.                 if [catch {eval $gfileSetsType($m)FilesetSelected \{$menu\} \{$item\}}] {
  819.                     # if that failed then just hope it's an ordinary list
  820.                     filesetBasicOpen $m $item
  821.                 }
  822.             }
  823.         }
  824.     }
  825.     
  826. }
  827.  
  828. proc filesetBasicOpen { menu item } {
  829.     if {[set match [lsearch [getFilesInSet $menu] *:$item]] >= 0} {
  830.         autoUpdateFileset $menu
  831.         generalOpenFile [lindex [getFilesInSet $menu] $match]
  832.     }
  833. }
  834.  
  835. proc generalOpenFile {file} {
  836.     getFileInfo $file a
  837.     if {$a(type) == "TEXT"} {
  838.         edit $file
  839.     } else {
  840.         sendOpenEvent -noreply Finder "${file}"
  841.     }
  842. }
  843.  
  844. proc registerUpdateProcedure { type proc } {
  845.     global filesetUpdateProcs
  846.     lappend filesetUpdateProcs($type) [list $proc]
  847. }
  848.  
  849. proc filesetUtilsProc { menu item } {
  850.     global filesetUtils gfileSetsType currFileSet filesetFlags filesetFlagsRebuild
  851.     if [info exists filesetUtils($item)] {
  852.         # it's a utility
  853.         set utilDesc $filesetUtils($item)
  854.         set allowedTypes [lindex $utilDesc 0]
  855.         if [string match $allowedTypes $gfileSetsType($currFileSet)] {
  856.             return [eval [lindex $utilDesc 1]]
  857.         } else {
  858.             beep
  859.             message "That utility can't be applied to the current file-set."
  860.             return
  861.         }
  862.     } elseif [info exists filesetFlags($item)] {
  863.         # it's a flag
  864.         
  865.         if [set    filesetFlags($item)    [expr 1    - $filesetFlags($item)]] {
  866.             markMenuItem "filesetFlags" $item on
  867.         } else {
  868.             markMenuItem "filesetFlags" $item off
  869.         }     
  870.          addArrDef filesetFlags "$item" "$filesetFlags($item)"
  871.         if [info exists filesetFlagsRebuild($item)] {
  872.             rebuildSomeFilesetMenu $filesetFlagsRebuild($item)
  873.         }
  874.         
  875.         return
  876.     } else {
  877.         $item
  878.     }
  879. }
  880.  
  881. proc getFilesInSet {fset} {
  882.     global gfileSets fileSetsTypesThing gfileSetsType
  883.     switch $fileSetsTypesThing($gfileSetsType($fset)) {
  884.         "list" {
  885.             return $gfileSets($fset)
  886.         }
  887.         "glob" {
  888.             global filesetFlags
  889.             if $filesetFlags(includeNonTextFiles) {
  890.                 return [glob -nocomplain "$gfileSets($fset)"]
  891.             } else {
  892.                 return [glob -nocomplain -t TEXT "$gfileSets($fset)"]
  893.             }
  894.         }
  895.         "procedural" {
  896.             return [$gfileSets($fset)]
  897.         }        
  898.         "default" {
  899.             global fileSets
  900.             return $fileSets($fset)
  901.         }
  902.     }
  903. }
  904.  
  905. proc makeFileSetAndMenu { name andMenu } {
  906.     global gfileSetsType fileSetsTypesThing
  907.     message "Building ${name}..."
  908.     set type $gfileSetsType($name)
  909.     switch $fileSetsTypesThing($type) {
  910.         "list" -
  911.         "glob" {
  912.             if $andMenu {
  913.                 set menu {}
  914.                 foreach m [getFilesInSet $name] {
  915.                     lappend menu "[file tail $m]\&"
  916.                 }
  917.                 return [makeFilesetSubMenu $name $name filesetProc -s -m [lsort -i $menu]]
  918.             } else {
  919.                 return
  920.             }
  921.         }
  922.         "procedural" {
  923.             return
  924.         }
  925.         "default" {
  926.             return [${type}MakeFileSetAndMenu $name $andMenu]
  927.         }
  928.     }     
  929. }
  930.  
  931. proc filesetsSorted { order usedvar } {
  932.     upvar $usedvar used
  933.     global filesetFlags gfileSets gfileSetsType
  934.     set sets {}
  935.     foreach item $order {
  936.         switch -- [lindex $item 0] {
  937.           "-" { 
  938.               # add divider
  939.             lappend sets "(-" 
  940.             continue
  941.           } 
  942.           "*" {
  943.             # add all the rest
  944.               set subset {}
  945.             foreach s [array names gfileSets] {
  946.                 if ![listContains $used $s]  {
  947.                     lappend subset $s
  948.                     lappend used $s
  949.                 }
  950.             }
  951.             foreach f [lsort $subset] {
  952.                 lappend sets [makeFileSetAndMenu $f 1]
  953.             }
  954.           } 
  955.           "pattern" {
  956.               # find all which match a given pattern
  957.               set patt [lindex $item 1]
  958.               set subset {}
  959.             foreach s [array names gfileSets] {
  960.                 if ![listContains $used $s]  {
  961.                     if [string match $patt $s] {
  962.                         lappend subset $s
  963.                         lappend used $s
  964.                     }
  965.                 }
  966.             }
  967.             foreach f [lsort $subset] {
  968.                 lappend sets [makeFileSetAndMenu $f 1]
  969.             }
  970.               
  971.           }
  972.           "submenu" {
  973.               # add a submenu with name following and sub-order
  974.               set name [lindex $item 1]
  975.             set suborder [lrange $item 2 end]              
  976.               # we make kind of a pretend fileset here.
  977.               set subsets [filesetsSorted $suborder used]
  978.               if { $subsets != "" } {
  979.                   lappend sets [makeFilesetSubMenu $name $name filesetProc -m $subsets]
  980.               }
  981.           }
  982.           "default" {        
  983.             set subset {} 
  984.             foreach s [array names gfileSets] {
  985.                 if {[listContains $item $gfileSetsType($s)] && ![listContains $used $s]}  {
  986.                     lappend subset $s
  987.                     lappend used $s
  988.                 }
  989.             }
  990.             foreach f [lsort $subset] {
  991.                 lappend sets [makeFileSetAndMenu $f 1]
  992.             }
  993.           }
  994.         }
  995.     
  996.     }
  997.     # remove multiple and leading, trailing '-' in case there were gaps
  998.     regsub -all {\(-( \(-)+} $sets {(-} sets
  999.     while { [lindex $sets 0] == "(-" } { set sets [lrange $sets 1 end] }
  1000.     set l [expr [llength $sets] -1]
  1001.     if { [lindex $sets $l] == "(-" } { set sets [lrange $sets 0 [incr l -1]] }
  1002.     
  1003.     return $sets
  1004. }
  1005.  
  1006.  
  1007. # This should be used by "AlphaBits.tcl" for the initial build.
  1008. # After that it is only necessary to call 'rebuildAllFilesets'.
  1009. # Currently this proc is only necessary for backwards compatibility
  1010. # It should be removed at some future date.
  1011. proc rebuildFilesetMenu {} { 
  1012.     global gfileSets gfileSetsType
  1013.     foreach fset [array names gfileSets] {
  1014.         if ![info exists gfileSetsType($fset)] { 
  1015.             addArrDef gfileSetsType "$fset" "fromDirectory"
  1016.             set gfileSetsType($fset) "fromDirectory" 
  1017.         }        
  1018.     }
  1019.     
  1020.     rebuildAllFilesets 
  1021. }
  1022.  
  1023. ## 
  1024.  # -------------------------------------------------------------------------
  1025.  #     
  1026.  #    "zapAndBuildFilesets" --
  1027.  #    
  1028.  #     This does a complete rebuild of all information.  The problem is that
  1029.  #     the names of menus    may    actually change    (spaces    added/deleted).    This
  1030.  #     is    not    a problem for the fileset menu,    but    is a problem for any
  1031.  #     filesets which    have been added    to other menus,    since they won't know
  1032.  #     that they need    to be rebuilt.
  1033.  # -------------------------------------------------------------------------
  1034.  ##
  1035. proc zapAndBuildFilesets {} {
  1036.     global subMenuInfo subMenuFilesetInfo
  1037.     unset subMenuInfo
  1038.     unset subMenuFilesetInfo
  1039.     rebuildAllFilesets
  1040. }
  1041.  
  1042. proc rebuildAllFilesets {} {
  1043.     global gfileSets fsetMenuName  filesetSortOrder 
  1044.     global filesetFlags filesetsNotInMenu
  1045.     
  1046.     if $filesetFlags(sortFilesetsByType) {
  1047.         # just make file-sets for those we don't want in the menu
  1048.         foreach f $filesetsNotInMenu {
  1049.             makeFileSetAndMenu $f 0
  1050.         }
  1051.         
  1052.         set used $filesetsNotInMenu
  1053.         set sets [filesetsSorted $filesetSortOrder used]
  1054.     } else {
  1055.         foreach f [lsort [array names gfileSets]] {
  1056.             set doMenu [expr ![listContains $filesetsNotInMenu $f]]
  1057.             set menu [makeFileSetAndMenu $f $doMenu]
  1058.             if { $doMenu && $menu != "" } {
  1059.                 lappend sets $menu
  1060.             }        
  1061.         }            
  1062.     }
  1063.     
  1064.     regsub -all {[-][nm]} $sets "" names
  1065.     set names [map cadr $names]
  1066.     set names [map "string trimright" $names]
  1067.  
  1068.     menu -m -n $fsetMenuName -p filesetMenuProc \
  1069.         [concat {{/'Edit File…} {menu -n Utilities {}}} "Help" \
  1070.         "(-" $sets]    
  1071.     rebuildFilesetUtilsMenu
  1072.     callFilesetUpdateProcedures
  1073.     
  1074.     message ""
  1075. }
  1076.  
  1077.  
  1078. ## 
  1079.  # -------------------------------------------------------------------------
  1080.  #     
  1081.  #    "rebuildSomeFilesetMenu" --
  1082.  #    
  1083.  #     If    given '*' rebuild the entire menu, else    rebuild    only those types
  1084.  #     given.     This is generally useful to avoid excessive rebuilding    when
  1085.  #     flags are adjusted
  1086.  # -------------------------------------------------------------------------
  1087.  ##
  1088. proc rebuildSomeFilesetMenu {amount} {
  1089.     global gfileSets gfileSetsType
  1090.     switch -- $amount {
  1091.         "*" {
  1092.             rebuildAllFilesets
  1093.         }
  1094.         "default" {
  1095.             foreach f [lsort [array names gfileSets]] {
  1096.                 if {$f == "Help"} continue
  1097.                 if [listContains $amount $gfileSetsType($f)] {
  1098.                     eval [makeFileSetAndMenu $f 1]
  1099.                 }
  1100.             
  1101.             }            
  1102.         }
  1103.     }
  1104.         
  1105. }
  1106.  
  1107. proc rebuildFilesetUtilsMenu {} {
  1108.     global gfileSets  currFileSet fileSetsTypesThing filesetUtils filesetFlags
  1109.  
  1110.     menu -n "Utilities" -p filesetUtilsProc [concat \
  1111.         "newFileset…" \
  1112.         "deleteFileset…" \
  1113.         "updateCurrentFileset" \
  1114.         "<S<EzapAndBuildFilesets" \
  1115.         "<SrebuildAllFilesets" \
  1116.         \{[list menu -n choose -m -p changeFileSet [lsort [array names gfileSets]]]\} \
  1117.         \{[list menu -n hideFileset -m -p hideShowFileset [lsort [array names gfileSets]]]\} \
  1118.         \{[list menu -n filesetFlags -p filesetUtilsProc [lsort [array names filesetFlags]]]\} \
  1119.         "(-" \
  1120.         "/T<I<OfindTag" \
  1121.         "createTagFile" \
  1122.         "(-" \
  1123.         [lsort [array names filesetUtils]] \
  1124.         ]
  1125.    
  1126.     filesetUtilsMarksTicks
  1127. }
  1128.  
  1129. proc rebuildSimpleFilesetMenus {} {
  1130.     global gfileSets fileSetsTypesThing
  1131.     menu -n choose -m -p changeFileSet [lsort [array names gfileSets]]
  1132.     menu -n createFileset -p createFileset [array names fileSetsTypesThing]
  1133.     menu -n hideFileset -m -p hideShowFileset [lsort [array names gfileSets]]
  1134.     filesetUtilsMarksTicks
  1135. }
  1136.  
  1137. proc hideShowFileset { menu item } {
  1138.     global filesetsNotInMenu fsetMenuName
  1139.     if [listContains $filesetsNotInMenu $item] {
  1140.         global gfileSetsType
  1141.         if {$gfileSetsType($item) == "procedural"} {
  1142.             alertnote "Sorry, procedural filesets are completely dynamic and cannot appear in menus."
  1143.             return
  1144.         }
  1145.         set idx [lsearch $filesetsNotInMenu $item]
  1146.         set filesetsNotInMenu [lreplace $filesetsNotInMenu $idx $idx]        
  1147.         markMenuItem -m hideFileset $item off
  1148.         # would be better if we could just insert it
  1149.         rebuildAllFilesets
  1150.     } else {
  1151.         lappend filesetsNotInMenu $item
  1152.         markMenuItem -m hideFileset $item on 
  1153.         removeMenu $item
  1154.         if [catch { deleteMenuItem -m $fsetMenuName $item }] {
  1155.             # it's on a submenu and I can't be bothered to write
  1156.             # code to find that submenu name right now.
  1157.             rebuildAllFilesets
  1158.         }
  1159.     }
  1160.     global modifiedVars
  1161.     lappend modifiedVars filesetsNotInMenu
  1162. }
  1163.  
  1164. proc filesetUtilsMarksTicks {} {
  1165.     global currFileSet filesetFlags filesetsNotInMenu
  1166.     markMenuItem -m choose $currFileSet on
  1167.     
  1168.     foreach flag [array names filesetFlags] {
  1169.         if $filesetFlags($flag) {
  1170.             markMenuItem "filesetFlags" $flag on
  1171.         } else {
  1172.             markMenuItem "filesetFlags" $flag off
  1173.         }     
  1174.     }
  1175.     
  1176.     foreach name $filesetsNotInMenu {
  1177.         markMenuItem -m hideFileset $name on
  1178.     }
  1179.     
  1180. }
  1181.  
  1182.  
  1183. # Called in response to user changing filesets from the fileset menu.
  1184. proc changeFileSet {menu item} {
  1185.     global currFileSet tagFile
  1186.     
  1187.     markMenuItem -m choose $currFileSet off
  1188.     set currFileSet $item
  1189.     markMenuItem -m choose $currFileSet on
  1190.  
  1191.     # Bring in the tags file for this fileset
  1192.     set fname [tagFileName]
  1193.     if {[file exists $fname]} {
  1194.         if {[askyesno "Use tag file from folder \"$dir\" ?"] == "yes"} {
  1195.             set tagFile $fname
  1196.         }
  1197.     }
  1198. }
  1199.  
  1200. proc autoUpdateFileset { name } {
  1201.     global currFileSet filesetFlags
  1202.     if $filesetFlags(autoAdjustFileset) {
  1203.         set currFileSet $name
  1204.     }
  1205. }
  1206.  
  1207. #############################################
  1208. #                                            #
  1209. #    Section    5: General Utility procedures    #
  1210. #                                            #
  1211. #############################################
  1212.  
  1213. proc isWindowInFileset { {win "" } {type ""} } {
  1214.     if {$win == ""} { set win [lindex [winNames -f] 0] }
  1215.     global currFileSet gfileSets gfileSetsType
  1216.  
  1217.     if { $type == "" } {
  1218.         set okSets [array names gfileSets]
  1219.     } else {
  1220.         set okSets {}
  1221.         foreach s [array names gfileSets] {
  1222.             if { $gfileSetsType($s) == $type } {
  1223.                 lappend okSets $s
  1224.             }
  1225.         }
  1226.     }
  1227.     
  1228.     if [array exists gfileSets] {
  1229.         if {[lsearch -exact $okSets $currFileSet] != -1 } {
  1230.             # check current fileset
  1231.             if {[lsearch -exact [getFilesInSet $currFileSet] $win] != -1 } {
  1232.                 # we're set, it's in this fileset
  1233.                 return  $currFileSet
  1234.             }
  1235.         }
  1236.         
  1237.         # check other fileset
  1238.         foreach fset $okSets {
  1239.             if {[lsearch -exact [getFilesInSet $fset] $win] != -1 } {
  1240.                 # we're set, it's in this project
  1241.                 return  $fset
  1242.             }
  1243.         }   
  1244.     }
  1245.     return ""
  1246.     
  1247. }
  1248.  
  1249.  
  1250.  
  1251. ## 
  1252.  # -------------------------------------------------------------------------
  1253.  #     
  1254.  #    "iterateFileset" --
  1255.  # 
  1256.  #       Utility procedure to    iterate    over all files in a    project,
  1257.  #       calling some    predefined function    '$fn' for each member of
  1258.  #       project '$proj'.    The    results    of such    a call are passed to
  1259.  #       '$resfn'    if given. Finally "done" is    passed to 'resfn'.
  1260.  #     
  1261.  # -------------------------------------------------------------------------
  1262.  ##
  1263. proc iterateFileset { proj fn { resfn \# } } {
  1264.     global gfileSets gfileSetsType
  1265.     eval $resfn "first"
  1266.  
  1267.     set check [expr ![catch {$gfileSetsType($proj)IterateCheck check}]]
  1268.     
  1269.     foreach ff [getFileSet $proj] {
  1270.         if { $check && [$gfileSetsType($proj)IterateCheck $proj $ff] } {
  1271.             continue
  1272.         }
  1273.         set res [eval $fn \{$ff\}]
  1274.         eval $resfn \{$res\}
  1275.         
  1276.     }
  1277.     
  1278.     if $check {
  1279.         catch {$gfileSetsType($proj)IterateCheck done}
  1280.     }
  1281.     
  1282.     eval $resfn "done"
  1283.  
  1284. }
  1285.  
  1286. ########################
  1287. #                       #
  1288. #    Section    6:    Tags   #
  1289. #                       #
  1290. ########################
  1291.  
  1292. if ![string length [info commands alphaFindTag]] {
  1293.     rename findTag alphaFindTag
  1294.     rename createTagFile alphaCreateTagFile
  1295. }
  1296.  
  1297. proc tagFileName {} {
  1298.     global gfileSets currFileSet 
  1299.     return [file dirname [car $gfileSets($currFileSet)]]:[join ${currFileSet}]TAGS
  1300. }
  1301.  
  1302. proc findTag {} {
  1303.     global gfileSetsType currFileSet
  1304.     # try a type-specific method first
  1305.     if [catch {$gfileSetsType($currFileSet)FindTag}] {
  1306.         alphaFindTag
  1307.     }
  1308. }
  1309.  
  1310. proc createTagFile {} {
  1311.     global gfileSetsType currFileSet tagFile modifiedVars
  1312.     set tagFile [tagFileName]
  1313.     lappend modifiedVars tagFile
  1314.  
  1315.     # try a type-specific method first
  1316.     if [catch {$gfileSetsType($currFileSet)CreateTagFile}] {
  1317.         alphaCreateTagFile
  1318.     }
  1319. }
  1320.  
  1321.  
  1322. ############################
  1323. #                           #
  1324. #        Section    7: Utils   #
  1325. #                           #
  1326. ############################
  1327.     
  1328.     
  1329. proc dirtyFileset { fset } {
  1330.     foreach f [getFilesInSet $fset] {
  1331.         if { ![catch {getWinInfo -w $f arr}] && $arr(dirty)} { return 1 }
  1332.     }
  1333.     return 0
  1334. }
  1335.  
  1336. proc saveEntireFileset { fset } {
  1337.     foreach f [getFilesInSet $fset] {
  1338.         if { ![catch {getWinInfo -w $f arr}] && $arr(dirty)} { 
  1339.             bringToFront $f
  1340.             save 
  1341.         }
  1342.     }
  1343. }
  1344.  
  1345. proc closeEntireFileset { {fset ""} } {
  1346.     set fset [pickFileset $fset "Close which fileset?" "popup"]
  1347.         
  1348.     foreach f [getFilesInSet $fset] {
  1349.         if ![catch {getWinInfo -w $f arr}] {
  1350.             bringToFront $f
  1351.             killWindow
  1352.         }
  1353.     }
  1354. }
  1355.  
  1356. proc fileToAlpha {f} {
  1357.     if {[file isfile $f] && ([getFileType $f] == "TEXT") && ([getFileSig $f] != "ALFA")} {
  1358.         message "Converting $f"
  1359.         setFileInfo $f creator ALFA
  1360.     }    
  1361. }
  1362.  
  1363. proc filesetToAlpha {} {
  1364.     set fset [pickFileset "" {Convert all files from which fileset?} "popup"]
  1365.     iterateFileset $fset fileToAlpha
  1366. }
  1367.  
  1368. ## 
  1369.  # -------------------------------------------------------------------------
  1370.  # 
  1371.  # "replaceInFileset" --
  1372.  # 
  1373.  #  Quotes things correctly so searches work, and adds a check on
  1374.  #  whether there are any windows.
  1375.  # -------------------------------------------------------------------------
  1376.  ##
  1377. proc replaceInFileset {} {
  1378.     global gfileSets
  1379.  
  1380.     set from [prompt "Search string:" [searchString]]
  1381.     searchString $from
  1382.     set from [quoteExpr $from]
  1383.     regsub -all {&} $from {\\&} from
  1384.     regsub -all {\^} $from {\\^} from
  1385.     regsub -all {\$} $from {\\$} from
  1386.     regsub -all {\?} $from {\\?} from
  1387.     set to [prompt "Replace string:" [replaceString]]
  1388.     replaceString $to
  1389.     regsub -all {&} $to {\\&} to
  1390.     set fsets [pickFileset "" "Which filesets?" "multilist"]
  1391.  
  1392.     if {[winNames] != ""} {
  1393.         if {[buttonAlert "Save all windows?" "Yes" "Cancel"] != "Yes"} return
  1394.         saveAll
  1395.     }
  1396.  
  1397.     set cid [scancontext create]
  1398.     scanmatch $cid $from {
  1399.         set matches($f) 1
  1400.     }
  1401.     foreach fset $fsets {
  1402.         foreach f [getFileSet $fset] {
  1403.             if {![catch {set fid [open $f]}]} {
  1404.                 message "Looking at '[file tail $f]'"
  1405.                 scanfile $cid $fid
  1406.                 close $fid
  1407.             }
  1408.         }
  1409.     }
  1410.     
  1411.     scancontext delete $cid
  1412.     
  1413.     foreach f [array names matches] {
  1414.         message "Modifying ${f}…"
  1415.         set cid [open $f "r"]
  1416.         if {[regsub -all $from [read $cid] $to out]} {
  1417.             set ocid [open $f "w+"]
  1418.             puts -nonewline $ocid $out
  1419.             close $ocid
  1420.         }
  1421.         close $cid
  1422.     }
  1423.     
  1424.     if {[winNames] != ""} {
  1425.         if {[buttonAlert "Revert affected windows?" "Yes" "No"] == "Yes"} {
  1426.             foreach f [array names matches] {
  1427.                 foreach w [winNames -f] {
  1428.                     set ww $w
  1429.                     regexp {(.*) <[0-9]+>} $w dummy w
  1430.                     if {$f == $w} {
  1431.                         bringToFront $ww
  1432.                         revert
  1433.                     }
  1434.                 }        
  1435.             }
  1436.         }
  1437.     }
  1438.     message ""
  1439. }
  1440.  
  1441. proc openEntireFileset {} {
  1442.     set fset [pickFileset "" "Open which fileset?" "popup"]
  1443.     
  1444.     # we use our iterator in case there's something special to do
  1445.     iterateFileset $fset "edit -c -w"
  1446. }
  1447.  
  1448. proc openFilesetFolder {} {
  1449.     global gfileSets
  1450.     set fset [pickFileset "" "Open which fileset's folder?" "popup"]
  1451.     titlebar [file dirname $gfileSets($fset)]
  1452. }
  1453.  
  1454. proc stuffFileset {} {
  1455.     global gfileSetsType gfileSets
  1456.     set fset [pickFileset "" "Which fileset shall I stuff?" "popup"]
  1457.     if [string length $fset] {
  1458.         if { $gfileSetsType($fset) == "fromDirectory" && \
  1459.              [askyesno "Stuff entire directory?"] == "yes" } {
  1460.              launchForeAppl DStf
  1461.              sendOpenEvent reply 'DStf' "[file dirname $gfileSets($fset)]:"
  1462.         } else {            
  1463.             launchForeAppl DStf
  1464.             eval sendOpenEvents 'DStf' [getFilesInSet $fset]
  1465.         }        
  1466.         sendQuitEvent 'DStf'
  1467.     }
  1468. }
  1469.  
  1470. proc filesetRememberOpenClose { file } {
  1471.     global fileset_openorclosed
  1472.     set fileset_openorclosed [list "$file" [lsearch -exact [winNames -f] $file]]
  1473. }
  1474.  
  1475. proc filesetRevertOpenClose { file } {
  1476.     global fileset_openorclosed
  1477.     if { [lindex $fileset_openorclosed 0] == "$file" } {
  1478.         if { [lindex $fileset_openorclosed 1] < 0 } {
  1479.             killWindow
  1480.         }
  1481.     }    
  1482.     catch {unset fileset_openorclosed}
  1483. }
  1484.  
  1485. proc wordCountFileset {} {
  1486.   global currFileSet
  1487.   iterateFileset $currFileSet wordCountProc filesetUtilWordCount
  1488. }
  1489.  
  1490. proc wordCountFilesetFast {} {
  1491.   global currFileSet
  1492.   iterateFileset $currFileSet wc filesetUtilWordCount
  1493. }
  1494.  
  1495. proc filesetUtilWordCount { count } {
  1496.     global fs_ccount fs_wcount fs_lcount
  1497.     switch $count {
  1498.         "first" {
  1499.             set fs_ccount 0
  1500.             set fs_wcount 0
  1501.             set fs_lcount 0
  1502.         }       
  1503.         "done" {
  1504.             alertnote "There were $fs_ccount lines, $fs_wcount words and $fs_ccount chars"
  1505.             unset fs_ccount fs_wcount fs_lcount
  1506.         }
  1507.         default {
  1508.             incr fs_ccount [lindex $count 2]
  1509.             incr fs_wcount [lindex $count 1]
  1510.             incr fs_lcount [lindex $count 0]
  1511.         }
  1512.     }
  1513. }
  1514.  
  1515.  
  1516.  
  1517. ##
  1518.  # ----------------------------------------------------------------------
  1519.  #
  1520.  #  "wordCountProc" --
  1521.  #
  1522.  #   We use this proc to count words.  Calling 'wc' would be quicker (it is a 
  1523.  #   C procedure and doesn't require the opening of a file), however it seems 
  1524.  #   to have a HUGE memory leak so is a bit useless for our purposes.
  1525.  #
  1526.  # ----------------------------------------------------------------------
  1527.  ##
  1528. proc wordCountProc { file } {
  1529.     filesetRememberOpenClose "$file"
  1530.     openFileQuietly "$file"
  1531.     set chars [maxPos]
  1532.     set lines [lindex [posToRowCol $chars] 0]
  1533.     set text [getText 0 [maxPos]]
  1534.     regsub -all {[!=;.,\(\#\=\):\{\"\}]} $text " " ret
  1535.     set words [llength $ret]
  1536.     unset text ret
  1537.     filesetRevertOpenClose $file
  1538.     return "$chars $words $lines"
  1539. }
  1540.  
  1541.  
  1542. ############################################
  1543. #    Section    2:    Basic fileset procedures   #
  1544. ############################################
  1545.  
  1546.  
  1547. proc findNewFileset {} {
  1548.     return [newFileset]
  1549. }
  1550.  
  1551.  
  1552. proc findNewDirectory {} {
  1553.     global gfileSets currFileSet gfileSetsType gDirScan
  1554.  
  1555.     set dir [string trim [get_directory -p "Scan which folder?"] ":"]
  1556.     if {![string length $dir]} return
  1557.     
  1558.     set filePat {*}
  1559.     set name [file tail $dir]
  1560.     
  1561.     set gfileSets($name) "$dir:$filePat"
  1562.     set gDirScan($name) 1
  1563.     set gfileSetsType($name) "fromDirectory"
  1564.     set currFileSet $name
  1565.     updateCurrentFileset
  1566.     return $name
  1567. }
  1568.  
  1569.  
  1570. # Should be last so all filesets make it in.
  1571. message "Building filesets..."
  1572.  
  1573. rebuildFilesetMenu
  1574.  
  1575.  
  1576.  
  1577.